COMMENT ⊗   VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(DE EVPROG(LOCALS BODY ENV)
C00004 00003	(DE EVPROG(LOCALS BODY ENV)
C00007 00004	~But now look where we are: each separate evaluator: EVPROG_COND,
C00011 00005	~Constructors, Selectors, and Predicates
C00013 00006	~selectors
C00014 00007	~constructors
C00015 00008	~primitive evaluators
C00016 ENDMK
C⊗;
(DE EVPROG(LOCALS BODY ENV)
 (EVPROG* BODY (BINDUP LOCALS ENV)(MAKE_GO_LIST BODY)) )

(DE EVPROG* (BODY ENV GO_LIST)
(COND ((NULL BODY)NIL)
      ((IS_COND (FIRST BODY)) (EVPROG_COND (FIRST BODY) 
					   ENV 
					   GO_LIST))
                              (EVPROG*(REST BODY) ENV GO_LIST))

      ((IS_SETQ (FIST BODY))  (SETQ* (ARG1 (FIRST BODY))
				     (ARG2 (FIRST BODY))
				     ENV)
                              (EVPROG* (REST BODY)EVN GOLIST))

      ((IS_SET (FIST BODY))   (SET* (ARG1 (FIRST BODY))
			            (ARG2 (FIRST BODY))
				    ENV)
                              (EVPROG* (REST BODY)EVN GOLIST))

      ((IS_GO (FIRST BODY))   (EVPROG*(GO* (ARG1(FIRST BODY))) ENV GO_LIST))

      ((IS_LABEL ))

      ((IS_RETURN (FIRST BODY)) (EVAL (ARG1(FIRST BODY))ENV))

      (T                       (EVAL(FIRST BODY) ENV))
                               (EVPROG*(REST BODY) ENV GOLIST)))
  )

(DE EVPROG(LOCALS BODY ENV)
 (EVPROG* BODY (BINDUP LOCALS ENV)(MAKE_GO_LIST BODY)) )

(DE EVPROG* (BODY ENV GO_LIST)
(COND ((NULL BODY)NIL)
      ((IS_COND (FIRST BODY)) (EVPROG_COND (ARG1(FIRST BODY))
					   ENV 
					   GO_LIST
					   (REST BODY)))

      ((IS_SETQ (FIRST BODY)) (SETQ* (ARG1 (FIRST BODY))
				     (ARG2 (FIRST BODY))
				     ENV
				     GO_LIST
~we need GO_LIST since turkey might (SETQ FOO (F (GO L)))
				     (REST BODY)))

      ((IS_SET (FIRST BODY))  (SET* (ARG1 (FIRST BODY))
			            (ARG2 (FIRST BODY))
				    ENV
				    GO_LIST
				    (REST BODY)))

      ((IS_GO (FIRST BODY))   (GO* (ARG1(FIRST BODY))
				    ENV 
			            GO_LIST))

      ((IS_LABEL ))

~     ((IS_RETURN (FIRST BODY)) (EVAL (ARG1(FIRST BODY))ENV))
~at this point it is clear EVAL needs  GOLIST or recode as RETURN*
      (IS_RETURN (FIRST BODY)) (RETURN* (ARG1(FIRST BODY)) 
					ENV 
					GO_LIST))

~     (T                       (EVAL(FIRST BODY) ENV))
~                              (EVPROG*(REST BODY) ENV GOLIST)))
~at this point it is again clear that EVAL should hve continuation;
~after EVAL there is No reason to come back to do the EVPROG*

      (T                      (EVAL_PROG* (FIRST BODY) 
					   ENV
					   GO_LIST
					   (REST BODY)) )
  )

(DE SETQ*(ARG1 ARG2 ENV GOS REST)
  (SETQ ARG1 (EVAL ARG2  ENV ???
~fucked again 
~it is quite clear that  EVAL must be rewritten to do this cleanly
~But now look where we are: each separate evaluator: EVPROG_COND,
~SETQ*, SET*, EV_REST*  is of the form evaluate n args using ENV and GO_LIST
~then  fondle (REST BODY)

~The other evaluators,  for GO, RETURN, and labels are degenerate cases of the
same thing.

~what all this says (since we want to handle arbitrary pieces of LISP to be
~evalauted inside progs) is that EVAL must be recoded
~for the moment lets keep ENV, GO_LIST, and (REST BODY) as separate compoments
~I don't want to think about them yet.
~ then we have (EVAL EXP ENV GO_LIST EXP*)

~inside EVAL:
~    ((IS_PROG EXP) (EVPROG* (LOCALS EXP)(BODY EXP) ENV GO_LIST EXP*)




(DE EVIL(EXP ENV GO_LIST EXP*)
 (COND
	((IS_CONST EXP)      (APP* EXP* EXP))
	((IS_VAR EXP)        (APP* EXP* (LOOK_UP EXP ENV)))
	((IS_COND EXP)       (EVIL(ANTE EXP)
				  ENV
				  GO_LIST
				  (MK_λ  @X
					 (MK_COND* @X
						   (MK_EVIL (CONSEQ EXP) ENV GO_LIST  EXP*)
						   (MK_EVIL (OW EXP)ENV GO_LIST EXP*)))
				)
	((IS_FUN_ARG  EXP)   (EVIL (FUN EXP)
				    ENV
				    GO_LIST
				    (MK_λ @Y 
					  (MK_EVIL (ARG1 EXP)
						   ENV
						   GO_LIST
						   (MK_λ @X
					 	         (MK_COMPOSE(MK_AP* @Y @X)EXP*))
						)))
				)


	((IS_LAMBDA EXP)     (APP*  EXP* (MK_λ @X (MK_EVIL (BODY EXP)
						     (BIND @X (VAR EXP) ENV)
						     GO_LIST
						     @*EMPTY*))) 
				)


	((IS_PROG EXP)        (EVPROG(LABEL_FREE (BODY EXP)))
				     (BINDUP LOCALS ENV)
				     (MK-GO_LIST (BODY EXP))  ~???probably not??
				     EXP*) )

	((IS_SETQ EXP)        (EVIL (ARG2 EXP)
				     ENV
				     GO_LIST
				     (MK_λ @X 
					   (MK_COMPOSE (MK_BIND (ARG1 EXP) @X)
						        EXP*)))
				)

	((IS_SET EXP)         (EVIL (ARG1 EXP)
				     ENV
				     GO_LIST
				     (MK_λ @X 
					   (MK_COMPOSE (MK_FUN @SETQ @X (ARG2 EXP))
						       EXP*)))
				)

	((IS_RETURN EXP)      (EVIL (ARG1 EXP)
				     ENV
				     GO_LIST
				     (MK_λ @X
					   (EXP* @X))???


	((IS_GO EXP))         (EVIL (ARG1 EXP)
				    ENV 
			            GO_LIST
				    (MK_λ @X 
					  (MK_EVIL X ENV GO_LIST EXP*)))
				    



	((IS_LABEL EXP))      (CDR (ASSOC EXP GOLIST))


(DE EVPROG (BODY ENV GOLIST EXP*)
(EVIL (FIRST BODY) ENV GO_LIST (MK_λ NIL (MK_COMPOSE (REST BODY) EXP*)))


~Constructors, Selectors, and Predicates

~predicates
(DE IS_CONST(X)(OR(NUMBERP X)(MEMQ X @(A B C D E F G H))) )

(DE IS_VAR(X)(AND (ATOM X)(NOT(NUMBERP X))) )

~(cond ante conseq ow)
(DE IS_COND(X)(EQ(CAR X) @cond) )

~(fun arg)
(DE IS_FUN_ARG(X)(AND (NOT(ATOM X)) (NOT(MEMQ(CAR X) @(car cdr cons eq atom)))) )

~(prog (loc) body)
(DE IS_PROG(X)(EQ(CAR X) @prog) )

~(set(q) arg1 arg2)
(DE IS_SETQ(X)(EQ(CAR X) @setq) )

(DE IS_SET(X)(EQ(CAR X) @set) )

~(return arg1)
(DE IS_RETURN(X)(EQ(CAR X) @return) )

~(go arg1)
(DE IS_GO(X)(EQ(CAR X) @go) )

(DE IS_LABEL(X)(ASSOC X GOLIST)) ~hack, hack

~(lambda var body)
(DE IS_LAMBDA(X)(EQ (CAR X) @lambda))

~selectors


~(cond ante conseq ow)
(DE ANTE(X)(CADR X))

(DE CONSEQ(X)(CADDR X))

(DE OW(X)(CADDR X))

~(fun arg)
(DE ARG (X)(CADR X))

(DE FUN(X)(CAR X))

~(lambda var body)
(DE VAR(X)(CADR X))

(DE BODY(X)(CADDR X))

~(prog(loc) body)
(DE LOC(X)(CADR X))

~(set(q) arg1 arg2)
(DE ARG1(X)(CADR X))

(DE ARG2(X)(CADR X))

~constructors
(DE MK_λ(VAR BODY)(LIST λ VAR BODY))

(DE MK_EVIL( E1 ENV GO_LIST E2)(LIST @EVIL E1 ENV GO_LIST E2))

(DE MK_COMPOSE
~primitive evaluators

(DE COND*(X Y Z)(COND((EQ X T) Y)(T Z)))

(DE AP*(X Y)(